home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Collections: Franz PD
/
Franz PD Disk #002 (19xx)(Amiga User Group Deutschland e.V.).zip
/
Franz PD Disk #002 (19xx)(Amiga User Group Deutschland e.V.).adf
/
HP-10C
/
functions.md
< prev
next >
Wrap
Text File
|
1988-02-24
|
7KB
|
384 lines
IMPLEMENTATION MODULE CalcFunctions;
(*
This module creates the functions for the calculator.
This is the lowest level module.
Four functions need the gadget information and are in the
Module CalcGadgets. These functions are:
STO
RCL
DEG (toggles between degrees and radians)
GOLD (selects alternate gadgets in display)
Created: Duncan Prindle, September 10, 1986
Modified: Perhaps
*)
FROM MathLib0 IMPORT pi, e,
RadToDeg, DegToRad,
sin, cos, tan, arctan,
exp, ln, log, power, sqrt;
VAR
Y : REAL;
Z : REAL;
T : REAL;
TEMP : REAL;
lastX : REAL;
PROCEDURE BLANK (): ErrorType;
BEGIN
RETURN NoError;
END BLANK;
PROCEDURE CLRStack;
BEGIN
X := 0.0;
Y := 0.0;
Z := 0.0;
T := 0.0;
END CLRStack;
PROCEDURE StackUp;
BEGIN
T := Z;
Z := Y;
Y := X;
END StackUp;
PROCEDURE StackDown;
BEGIN
X := Y;
Y := Z;
Z := T;
END StackDown;
PROCEDURE Add (): ErrorType;
BEGIN
lastX:= X;
TEMP := X;
StackDown;
X := X + TEMP;
RETURN NoError;
END Add;
PROCEDURE Subtract (): ErrorType;
BEGIN
lastX:= X;
TEMP := X;
StackDown;
X := X - TEMP;
RETURN NoError;
END Subtract;
PROCEDURE Multiply (): ErrorType;
BEGIN
lastX:= X;
TEMP := X;
StackDown;
X := X * TEMP;
RETURN NoError;
END Multiply;
PROCEDURE Divide (): ErrorType;
BEGIN
IF X = 0.0 THEN
RETURN DivideByZero;
ELSE;
lastX:= X;
TEMP := X;
StackDown;
X := X / TEMP;
RETURN NoError;
END;
END Divide;
PROCEDURE POINT (): ErrorType;
BEGIN
IF ~SAME THEN StackUp; END;
DECI := TRUE;
NDeci := 0;
RETURN NoError;
END POINT;
PROCEDURE PI (): ErrorType;
BEGIN
StackUp;
X := pi;
RETURN NoError;
END PI;
PROCEDURE CLX (): ErrorType;
BEGIN
X := 0.0;
RETURN NoError;
END CLX;
PROCEDURE RDN (): ErrorType;
BEGIN
TEMP := X;
StackDown;
T := TEMP;
RETURN NoError;
END RDN;
PROCEDURE ENTER (): ErrorType;
BEGIN
IF SAME
THEN SAME := FALSE;
ELSE StackUp;
END;
DECI := FALSE;
NDeci:= 0;
RETURN NoError;
END ENTER;
PROCEDURE LASTX (): ErrorType;
BEGIN
StackUp;
X := lastX;
RETURN NoError;
END LASTX;
PROCEDURE SIN (): ErrorType;
BEGIN
lastX:= X;
IF INDEG THEN X := DegToRad( X ); END;
IF ABS(X) > 2.6E5
THEN IF INDEG THEN X := RadToDeg( X ); END;
RETURN XTooBigForSIN;
ELSE X := sin(X);
RETURN NoError;
END;
END SIN;
PROCEDURE ASIN (): ErrorType;
BEGIN
IF ABS(X) > 1.0 THEN
RETURN AsinTooBig;
ELSE
lastX:= X;
IF X = 1.0 THEN X := pi/2.0;
ELSIF X = -1.0 THEN X := -pi/2.0;
ELSE X := arctan( X / sqrt(1.0-X*X));
END;
IF INDEG THEN X := RadToDeg( X ); END;
RETURN NoError;
END;
END ASIN;
PROCEDURE COS (): ErrorType;
BEGIN
lastX:= X;
IF INDEG THEN X := DegToRad( X ); END;
IF ABS(X) > 2.6E5
THEN IF INDEG THEN X := RadToDeg( X ); END;
RETURN XTooBigForCOS;
ELSE X := cos(X);
RETURN NoError;
END;
END COS;
PROCEDURE ACOS (): ErrorType;
BEGIN
IF ABS(X) > 1.0 THEN
RETURN AcosTooBig;
ELSE
lastX:= X;
IF X = 1.0 THEN X := 0.0;
ELSIF X = -1.0 THEN X := pi;
ELSE X := pi/2.0 - arctan( X / sqrt(1.0-X*X) );
END;
IF INDEG THEN X := RadToDeg( X ); END;
RETURN NoError;
END;
END ACOS;
PROCEDURE TAN (): ErrorType;
BEGIN
lastX:= X;
IF INDEG THEN X := DegToRad( X ); END;
IF X > 6.5E4
THEN IF INDEG THEN X := RadToDeg( X ); END;
RETURN XTooBigForTAN;
ELSIF ABS(cos(X)) < 1.0E-6
THEN IF INDEG THEN X := RadToDeg( X ); END;
RETURN piOver2;
ELSE X := tan(X);
RETURN NoError;
END;
END TAN;
PROCEDURE ATAN (): ErrorType;
BEGIN
lastX:= X;
X := arctan(X);
IF INDEG THEN X := RadToDeg( X ); END;
RETURN NoError;
END ATAN;
PROCEDURE LN (): ErrorType;
BEGIN
IF X <= 0.0 THEN
RETURN NegLn;
ELSE
lastX:= X;
X := ln(X);
RETURN NoError;
END;
END LN;
PROCEDURE EXP (): ErrorType;
BEGIN
IF ABS(X) > 88.0 THEN
RETURN OverFlow;
ELSE
lastX:= X;
X := exp(X);
RETURN NoError;
END;
END EXP;
PROCEDURE TENtotheX (): ErrorType;
BEGIN
IF ABS(X) > 38.0 THEN
RETURN OverFlow;
ELSE
lastX:= X;
X := power( 10.0, X);
RETURN NoError;
END;
END TENtotheX;
PROCEDURE LOG (): ErrorType;
BEGIN
IF X <= 0.0 THEN
RETURN NegLog;
ELSE
lastX:= X;
X := log(X);
RETURN NoError;
END;
END LOG;
PROCEDURE YtotheX (): ErrorType;
BEGIN
lastX:= X;
Y := power( Y, X);
StackDown;
RETURN NoError;
END YtotheX;
PROCEDURE OneOverX (): ErrorType;
BEGIN
IF X = 0.0 THEN
RETURN DivideByZero;
ELSE
lastX:= X;
X := 1.0/X;
RETURN NoError;
END;
END OneOverX;
PROCEDURE XSquared (): ErrorType;
BEGIN
IF ABS(X) > 1.8E19 THEN
RETURN OverFlow;
ELSE
lastX:= X;
X := X * X;
RETURN NoError;
END;
END XSquared;
PROCEDURE SQRT (): ErrorType;
BEGIN
IF X < 0.0 THEN
RETURN NegSqrt;
ELSE
lastX:= X;
X := sqrt( X );
RETURN NoError;
END;
END SQRT;
PROCEDURE XtoY (): ErrorType;
BEGIN
TEMP := X;
X := Y;
Y := TEMP;
RETURN NoError;
END XtoY;
PROCEDURE CHS (): ErrorType;
BEGIN
X := -X;
RETURN NoError;
END CHS;
PROCEDURE CLRST (): ErrorType;
BEGIN
CLRStack;
RETURN NoError;
END CLRST;
PROCEDURE EXTENDX( Digit: CARDINAL );
VAR I : INTEGER;
BEGIN
IF SAME THEN
IF DECI
THEN NDeci := NDeci + 1;
IF X > 0.0
THEN X := X + FLOAT( Digit ) /
power( 10.0, FLOAT( CARDINAL(ABS(NDeci)) ));
ELSE X := X - FLOAT( Digit ) /
power( 10.0, FLOAT( CARDINAL(ABS(NDeci)) ));
END;
ELSE IF X > 0.0
THEN X := FLOAT(10) * X + FLOAT( Digit );
ELSE X := FLOAT(10) * X - FLOAT( Digit );
END;
END;
ELSE
StackUp;
SAME := TRUE;
IF DECI
THEN NDeci := 1;
X := FLOAT( Digit ) / 10.0;
ELSE X := FLOAT( Digit );
END;
END;
END EXTENDX;
BEGIN
(* Initialize variables *)
X := 0.0;
Y := 0.0;
Z := 0.0;
T := 0.0;
TEMP := 0.0;
lastX := 0.0;
SAME := FALSE;
INDEG := FALSE;
DECI := FALSE;
FOR NDeci := 0 TO 9 DO
stored[NDeci] := 0.0;
END;
NDeci := 0;
END CalcFunctions.